home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / info-service / gopher / Unix / go4gw1.1 / g2nntp < prev    next >
Encoding:
Text File  |  1993-04-30  |  7.2 KB  |  300 lines
  1. #!/usr/local/bin/perl
  2.  
  3. #----------------------------------------------------------------------
  4. # variables you might have to change:
  5.  
  6. $nntp_server = "news.cis.umn.edu";
  7. $nntp_port   = 119;
  8. $nntp_defart = "article";
  9. $nntp_groups = "/etc/go4gw/ACTIVE"; # could be active file
  10. $nntp_reverse = 0;  # to list articles in reverse order
  11.  
  12. #----------------------------------------------------------------------
  13.  
  14. @nntp_acl=(
  15. #     ipaddress  group    access + = allow, - = deny    
  16.      '^134.84\.  .*       +',
  17.      '^128.101\. .*       +',
  18.      '^131.212\. .*       +',
  19.      '^146.57\.  .*       +',
  20.      '.*         ^clari   -',
  21.      '.*         .*       +'
  22.   );
  23. # end of variables
  24.  
  25. # Commands this server responds to:
  26. # 
  27. # ""                         -> list top level groups
  28. # ls  [$group] [$range]      -> list group's articles and sub-groups
  29. # lsa [$group] [$range]      -> like "", sends "article" & "lsa" commands back
  30. # lsb [$group] [$range]      -> "" sends "body" & "lsb" commands back
  31. # lsh [$group] [$range]      -> "" sends "header" & "lsh" commands back
  32. # article <id>               -> get article by ID
  33. # article $group $number     -> get 1 article, number can be "last" or "first",
  34. #                               or any numeric perl expression.
  35. # body <id>                  -> like article, but just get text
  36. # body $group $number        -> ""
  37. # head <id>                  -> like article, but just get header
  38. # head $group $number        -> ""
  39. # sorry                      -> send sorry message
  40. #
  41. # The optional $range arguement has the following format:
  42. #      n         - return 'n' most recent articles
  43. #     x:y        - return articles x through y (inclusive)
  44. #                  x and y can both be numeric perl expressions. The
  45. #                  string 'last' is replaced with the last article in the
  46. #                  group, and the string 'first' is replaced with the first.
  47. #   first:last   - all articles (same as not specifiying a range
  48. #   last:first   - all articles (in reverse order)
  49. #  last-9:last   - return last 10 articles (same as specifiying 10)
  50. #  last:last-9   - return last 10 articles in reverse order
  51.  
  52.  
  53. sub nntp_main {
  54.   local($_) = @_;
  55.  
  56.   &do_ls("",$nntp_defart,"ls") if /^$/;
  57.   &do_ls("",$nntp_defart,"ls") if /^ls\s*$/;
  58.   &do_ls($1,$nntp_defart,"ls") if /^ls\s+(.*)/i;
  59.  
  60.   &do_ls("","article","lsa") if /^lsa\s*$/;
  61.   &do_ls($1,"article","lsa") if /^lsa\s+(.*)/i;
  62.  
  63.   &do_ls("","body","lsb") if /^lsb\s*$/;
  64.   &do_ls($1,"body","lsb") if /^lsb\s+(.*)/i;
  65.  
  66.   &do_ls("","head","lsh") if /^lsh\s*$/;
  67.   &do_ls($1,"head","lsh") if /^lsh\s+(.*)/i;
  68.  
  69.   &do_article($1,$2,"ARTICLE") if /^article\s+(\S+)\s+(\S+)/i;
  70.   &do_article_id($1,"ARTICLE") if /^article\s+(<.*>)/i;
  71.  
  72.   &do_article($1,$2,"HEAD") if /^head\s+(\S+)\s+(\S+)/i;
  73.   &do_article_id($1,"HEAD") if /^head\s+(<.*>)/i;
  74.  
  75.   &do_article($1,$2,"BODY") if /^body\s+(\S+)\s+(\S+)/i;
  76.   &do_article_id($1,"BODY") if /^body\s+(<.*>)/i;
  77.  
  78.   &Gsorry if /^sorry$/;
  79.   &Gabort("Unknown command!");
  80.   exit;
  81. }
  82.  
  83. sub do_article_id {
  84.   local($id,$cmd) = @_;
  85.   &open_nntp;
  86.   &Gsend("$cmd $id");
  87.   $_ = &Grecv;
  88.   &Gabort($_) if !/^2/;
  89.  
  90.   while(<GSERVER>) {
  91.     print;
  92.     last if /^\.\r\n$/;
  93.   }
  94.  
  95.   &close_nntp;
  96.   exit;
  97.  
  98. }
  99.  
  100. sub do_article {
  101.   local($group,$number,$cmd) = @_;
  102.  
  103.   if (&check_access($group) eq '-')  { &Gsorry; }
  104.   &open_nntp;
  105.  
  106.   &Gsend("GROUP $group");
  107.   $_ = &Grecv;
  108.   &Gabort($_) if !/^2/;
  109.   ($n,$f,$l) = /\d+\s+(\d+)\s+(\d+)\s+(\d+)/;
  110.  
  111.   $number =~ s/first/\$f/g;
  112.   $number =~ s/last/\$l/g;
  113.   $number = int(eval($number));
  114.  
  115.   &Gsend("$cmd $number");
  116.   $_ = &Grecv;
  117.   &Gabort($_) if !/^2/;
  118.  
  119.   while(<GSERVER>) {
  120.     print;
  121.     last if /^\.\r\n$/;
  122.   }
  123.  
  124.   &close_nntp;
  125.   exit;
  126. }
  127.  
  128. sub list_group {
  129.   local($group,$type,$range) = @_;
  130.  
  131.   &Gsend("GROUP $group");
  132.   $_ = &Grecv;
  133.   &Gabort($_) if !/^211/;
  134.  
  135.   ($n,$f,$l) = /211\s+(\d+)\s+(\d+)\s+(\d+)/;
  136.  
  137.   if ($range =~ /^(\S+):(\S+)$/) {
  138.       $low = $1; $high = $2;
  139.       $low =~ s/first/\$f/g;
  140.       $low =~ s/last/\$l/g;
  141.       $high =~ s/first/\$f/g;
  142.       $high =~ s/last/\$l/g;
  143.       $low  = int(eval($low));
  144.       $high = int(eval($high));
  145.       if ($low > $l) { $low = $l; }
  146.       elsif ($low < $f) {$low = $f; }
  147.       if ($high > $l) { $high = $l; }
  148.       elsif ($high < $f) {$high = $f; }
  149.  
  150.       if ($high < $low)  {  $f = $high; $l = $low;  $nntp_reverse=1; }
  151.       if ($low <= $high) {  $f = $low; $l = $high;  $nntp_reverse=0; }
  152.         
  153.   }
  154.   elsif ($range ne '') {
  155.        $range =~ s/first/\$f/g;
  156.        $range =~ s/last/\$l/g;
  157.        $range = int(eval($range));
  158.        if ($range >0 && $range < $n) {  $f = $l - $range + 1; }
  159.   }
  160.  
  161.   &Gsend("XHDR Subject $f-$l");
  162.   $_ = &Grecv;
  163.   &Gabort($_) if !/^221/;
  164.  
  165.   while(<GSERVER>) {
  166.     chop; chop;
  167.     last if /^\.$/;
  168.     ($article,$subject) = /^(\d+)\s+(.*)/;
  169.     $subject =~ s/\t/ /g; # just in case!
  170.     if ($nntp_reverse) {
  171.        push(@reply,"0$subject\t$Ggw $atype $group $article\t$Ghost\t$Gport");
  172.     } else {
  173.        &Greply("0$subject\t$Ggw $atype $group $article\t$Ghost\t$Gport");
  174.     }
  175.   }
  176.  
  177.   if ($nntp_reverse) {
  178.     for ($i=$#reply; $i!= -1; $i--) { &Greply($reply[$i]); } 
  179.   }
  180.  
  181.   &Greply(".");
  182.   &close_nntp;
  183.   exit;
  184. }
  185.  
  186. sub do_ls {
  187.   local($prefix,$atype,$lscmd) = @_;
  188.   local($range);
  189.  
  190.   $prefix =~ s/\s+$//;
  191.  
  192.   if ($prefix =~ /(\S+)\s+(\S+)/) {
  193.       $prefix = $1;
  194.       $range  = $2;
  195.   }
  196.   elsif (($prefix =~ /^\d+$/) || ($prefix =~ /:/)) {
  197.       $range = $prefix;
  198.       $prefix = "";
  199.   }
  200.  
  201.   if (&check_access($prefix) eq '-') {
  202.       &Greply("0Sorry! No access off of campus!\t$Ggw sorry\t$Ghost\t$Gport");
  203.       &Greply("."); 
  204.       exit; 
  205.   }
  206.  
  207.   &open_nntp;
  208.   &get_groups;
  209.  
  210.   foreach ( sort @groups) {
  211.     if ($_ eq $prefix) { $do_list_group = $_; }
  212.     elsif (/^$prefix\.([^.]*)\.?/) {
  213.       $leaf=$1;
  214.       $save{"$prefix.$leaf"} = "1$leaf\t$Ggw $lscmd $prefix.$leaf $range\t$Ghost\t$Gport";
  215.     }
  216.     elsif ($prefix eq '' && /([^.]*)/) {
  217.          $save{"$1"} = "1$1\t$Ggw $lscmd $1 $range\t$Ghost\t$Gport";
  218.     }
  219.   }
  220.  
  221.   foreach ( sort keys %save) { &Greply($save{$_}); }
  222.   &list_group($do_list_group,$atype,$range) if ($do_list_group);
  223.  
  224.   &Greply(".");
  225.   &close_nntp;
  226.   exit;
  227. }
  228.  
  229. sub open_nntp {
  230.   local($_);
  231.   &GopenServer($nntp_server,$nntp_port);
  232.   $_ = &Grecv;
  233.   &Gabort($_) if !/^2/;
  234. }
  235.  
  236. sub close_nntp {
  237.   &Gsend("QUIT");
  238.   close(GSERVER);
  239. }
  240.  
  241. sub get_groups {
  242.  if (open(GROUPS,$nntp_groups)) {
  243.       while(<GROUPS>) {
  244.           chop;
  245.           ($grp) = /^(\S+)/;
  246.           push(@groups,$grp);
  247.       }
  248.       close(GROUPS);
  249.  } else {                  # can't open file, get list from server!
  250.   &load_groups;
  251.  }
  252. }
  253.  
  254. sub load_groups {
  255.  
  256.   &open_nntp;
  257.   &Gsend("LIST");
  258.   $_ = &Grecv;
  259.   &Gabort($_) if !/^215/;
  260.  
  261.   while(<GSERVER>) {
  262.     chop; chop;
  263.     last if /^\.$/;
  264.     s/^(\S+).*/$1/;
  265.     push(@groups,$_);
  266.   }
  267.  
  268. }
  269.  
  270. sub create_groups { 
  271.   &load_groups;
  272.   open(GROUPS,">$nntp_groups") || die "$nntp_groups: $!";
  273.   foreach (@groups) { print GROUPS "$_\n"; }
  274.   close GROUPS;
  275.   &close_nntp;
  276.   exit;
  277. }
  278.  
  279. sub check_access {
  280.    local($group)=@_;
  281.  
  282.    return 1 if (-t STDIN);
  283.    $sockaddr = 'S n a4 x8';
  284.    $mysockaddr = getpeername(STDIN);
  285.    ($ramily,$rport,$raddr) = unpack($sockaddr,$mysockaddr);
  286.    ($a,$b,$c,$d) = unpack('C4',$raddr);
  287.    $ipaddress = "$a.$b.$c.$d";
  288.  
  289.    foreach (@nntp_acl) {
  290.       ($ipacl,$groupacl,$access)=split;
  291.       return $access if  ($ipaddress =~ /$ipacl/) && ($group =~ /$groupacl/);
  292.    }
  293.    return '-'; #default is to restrict access
  294. }
  295.  
  296. 1; # for require
  297.  
  298.  
  299.  
  300.